home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 037a / epb15.zip / EPB.PAS < prev   
Pascal/Delphi Source File  |  1991-09-07  |  19KB  |  842 lines
  1. {ED'S PASCAL BEAUTIFIER v1.5}
  2. {Copyright 1990 by Edward Lee}
  3. {edlee@chinet.chi.il.us}
  4. {Turbo Pascal v4.0}
  5.  
  6. {31Jan1990 20:00}{Program begun}
  7. {1 Feb1990 16:41}
  8. {2 Feb1990 16:47}{v1.0 complete}{Capitalizes keywords}
  9. {4 Feb1990 22:34}{v1.1 complete}{-Lower case option added}
  10. {7 Feb1990 00:29}{v1.2 complete}{Non-alphabetic token padding added}{Identifier parsing debugged}
  11. {25Mar1990 21:15}{v1.3 maintenance}{ ) append rule modified; (***) parsing debugged; REGISTERS and TEXT keywords added}
  12. {26May1990 16:56}{v1.4 complete}{optimized loop in identifier parsing}{Added identifier substitution option}
  13. {7 Sep1991 13:03}{v1.5 maintenance}
  14.   {The inputfile and outputfile may have the same name.}
  15.   {If only the inputfile is specified, the outputfile is assumed to be same name unless -o to STDOUT is specified.}
  16.   {An extension of .PAS is assumed for filenames if the extension is not specified.}
  17. {Possible future feature:  full, automatic indentation}
  18.  
  19. LABEL
  20.   findasterisk, out, start;
  21.  
  22. CONST
  23.   nkeys = 258;  (* Number of key strings to capitalize *)
  24.  
  25.   listkeys : ARRAY [1..nkeys] OF STRING [17] =
  26. (
  27. 'ABS',
  28. 'ABSOLUTE',
  29. 'ADDR',
  30. 'AND',
  31. 'APPEND',
  32. 'ARC',
  33. 'ARCTAN',
  34. 'ARRAY',
  35. 'ASSIGN',
  36. 'ASSIGNCRT',
  37. 'BAR',
  38. 'BAR3D',
  39. 'BEGIN',
  40. 'BLOCKREAD',
  41. 'BLOCKWRITE',
  42. 'BOOLEAN',
  43. 'BYTE',
  44. 'CASE',
  45. 'CHAR',
  46. 'CHDIR',
  47. 'CHR',
  48. 'CIRCLE',
  49. 'CLEARDEVICE',
  50. 'CLEARVIEWPORT',
  51. 'CLOSE',
  52. 'CLOSEGRAPH',
  53. 'CLREOL',
  54. 'CLRSCR',
  55. 'COMP',
  56. 'CONCAT',
  57. 'CONST',
  58. 'COPY',
  59. 'COS',
  60. 'CSEG',
  61. 'DEC',
  62. 'DELAY',
  63. 'DELETE',
  64. 'DELLINE',
  65. 'DETECTGRAPH',
  66. 'DISKFREE',
  67. 'DISKSIZE',
  68. 'DISPOSE',
  69. 'DIV',
  70. 'DO',
  71. 'DOSEXITCODE',
  72. 'DOUBLE',
  73. 'DOWNTO',
  74. 'DRAWPOLY',
  75. 'DSEG',
  76. 'ELLIPSE',
  77. 'ELSE',
  78. 'END',
  79. 'EOF',
  80. 'EOLN',
  81. 'ERASE',
  82. 'EXEC',
  83. 'EXIT',
  84. 'EXP',
  85. 'EXTENDED',
  86. 'EXTERNAL',
  87. 'FALSE',
  88. 'FILE',
  89. 'FILEPOS',
  90. 'FILESIZE',
  91. 'FILLCHAR',
  92. 'FILLPOLY',
  93. 'FINDFIRST',
  94. 'FINDNEXT',
  95. 'FLOODFILL',
  96. 'FLUSH',
  97. 'FOR',
  98. 'FORWARD',
  99. 'FRAC',
  100. 'FREEMEM',
  101. 'FUNCTION',
  102. 'GETARCCOORDS',
  103. 'GETASPECTRATIO',
  104. 'GETBKCOLOR',
  105. 'GETCOLOR',
  106. 'GETDATE',
  107. 'GETDIR',
  108. 'GETFATTR',
  109. 'GETFILLPATTERN',
  110. 'GETFILLSETTINGS',
  111. 'GETFTIME',
  112. 'GETGRAPHMODE',
  113. 'GETIMAGE',
  114. 'GETINTVEC',
  115. 'GETLINESETTINGS',
  116. 'GETMAXCOLOR',
  117. 'GETMAXX',
  118. 'GETMAXY',
  119. 'GETMEM',
  120. 'GETMODERANGE',
  121. 'GETPALLETTE',
  122. 'GETPIXEL',
  123. 'GETTEXTSETTINGS',
  124. 'GETTIME',
  125. 'GETVIEWSETTINGS',
  126. 'GETX',
  127. 'GETY',
  128. 'GOTO',
  129. 'GOTOXY',
  130. 'GRAPHDEFAULTS',
  131. 'GRAPHERRORMESG',
  132. 'GRAPHRESULT',
  133. 'HALT',
  134. 'HI',
  135. 'HIGHVIDEO',
  136. 'IF',
  137. 'IMAGESIZE',
  138. 'IMPLEMENTATION',
  139. 'IN',
  140. 'INC',
  141. 'INITGRAPH',
  142. 'INLINE',
  143. 'INSERT',
  144. 'INSLINE',
  145. 'INT',
  146. 'INTEGER',
  147. 'INTERFACE',
  148. 'INTERRUPT',
  149. 'INTR',
  150. 'IORESULT',
  151. 'KEEP',
  152. 'KEYPRESSED',
  153. 'LABEL',
  154. 'LENGTH',
  155. 'LINE',
  156. 'LINEREL',
  157. 'LINETO',
  158. 'LN',
  159. 'LO',
  160. 'LONGINT',
  161. 'LOWVIDEO',
  162. 'MARK',
  163. 'MAXAVAIL',
  164. 'MEMAVAIL',
  165. 'MKDIR',
  166. 'MOD',
  167. 'MOVE',
  168. 'MOVEREL',
  169. 'MOVETO',
  170. 'MSDOS',
  171. 'NEW',
  172. 'NIL',
  173. 'NORMVIDEO',
  174. 'NOSOUND',
  175. 'NOT',
  176. 'ODD',
  177. 'OF',
  178. 'OFS',
  179. 'OR',
  180. 'ORD',
  181. 'OUTTEXT',
  182. 'OUTTEXTXY',
  183. 'PACKED',
  184. 'PACKTIME',
  185. 'PARAMCOUNT',
  186. 'PARAMSTR',
  187. 'PI',
  188. 'PIESLICE',
  189. 'POINTER',
  190. 'POS',
  191. 'PRED',
  192. 'PROCEDURE',
  193. 'PROGRAM',
  194. 'PTR',
  195. 'PUTIMAGE',
  196. 'PUTPIXEL',
  197. 'RANDOM',
  198. 'RANDOMIZE',
  199. 'READ',
  200. 'READKEY',
  201. 'READLN',
  202. 'REAL',
  203. 'RECORD',
  204. 'RECTANGLE',
  205. 'REGISTERBGIFONT',
  206. 'REGISTERBGIDRIVER',
  207. 'REGISTERS',
  208. 'RELEASE',
  209. 'RENAME',
  210. 'REPEAT',
  211. 'RESET',
  212. 'RESTORECRTMODE',
  213. 'REWRITE',
  214. 'RMDIR',
  215. 'ROUND',
  216. 'SEEK',
  217. 'SEEKEOF',
  218. 'SEEKEOLN',
  219. 'SEG',
  220. 'SET',
  221. 'SETACTIVEPAGE',
  222. 'SETALLPALETTE',
  223. 'SETBKCOLOR',
  224. 'SETCOLOR',
  225. 'SETDATE',
  226. 'SETFATTR',
  227. 'SETFILLPATTERN',
  228. 'SETFILLSTYLE',
  229. 'SETFTIME',
  230. 'SETGRAPHBUFSIZE',
  231. 'SETGRAPHMODE',
  232. 'SETINTVEC',
  233. 'SETLINESTYLE',
  234. 'SETPALETTE',
  235. 'SETTEXTBUF',
  236. 'SETTEXTJUSTIFY',
  237. 'SETTEXTSTYLE',
  238. 'SETTIME',
  239. 'SETUSERCHARSIZE',
  240. 'SETVIEWPORT',
  241. 'SETVISUALPAGE',
  242. 'SHORTINT',
  243. 'SHL',
  244. 'SHR',
  245. 'SIN',
  246. 'SINGLE',
  247. 'SIZEOF',
  248. 'SOUND',
  249. 'SPTR',
  250. 'SQR',
  251. 'SQRT',
  252. 'SSEG',
  253. 'STR',
  254. 'STRING',
  255. 'SUCC',
  256. 'SWAP',
  257. 'TEXT',
  258. 'TEXTBACKGROUND',
  259. 'TEXTCOLOR',
  260. 'TEXTHEIGHT',
  261. 'TEXTMODE',
  262. 'TEXTWIDTH',
  263. 'THEN',
  264. 'TO',
  265. 'TRUE',
  266. 'TRUNC',
  267. 'TRUNCATE',
  268. 'TYPE',
  269. 'UNIT',
  270. 'UNPACKTIME',
  271. 'UNTIL',
  272. 'UPCASE',
  273. 'USES',
  274. 'VAL',
  275. 'VAR',
  276. 'WHEREX',
  277. 'WHEREY',
  278. 'WHILE',
  279. 'WINDOW',
  280. 'WITH',
  281. 'WORD',
  282. 'WRITE',
  283. 'WRITELN',
  284. 'XOR'
  285. );  (* const listkeys (whew!) *)
  286.  
  287.   sizebuf = 65535;  (* Let's go for the maximum buffer size *)
  288.  
  289. TYPE
  290.   mybuf = ARRAY [0..65534] OF CHAR;
  291.  
  292. VAR
  293.   a, b              (* Input and Output buffer pointers *)
  294. : ^mybuf;
  295.  
  296.   istream, lowercase, ostream, showbrackcom, showparencom
  297. : BOOLEAN;
  298.  
  299.   ch, lastch
  300. : CHAR;
  301.  
  302.   infile, outfile
  303. : FILE;
  304.  
  305.   i
  306. : INTEGER;
  307.  
  308.   ext, filename, iname, lstr, oname, Oident, path, RLident, RUident, s, ustr
  309. : STRING;
  310.  
  311.   ia, ib, nread, nwrit
  312. : WORD;
  313.  
  314.  
  315. FUNCTION binsearch (s : STRING) : BOOLEAN;
  316. (*
  317.  * Binary Search variation:  success or failure returned, no index returned
  318.  *
  319.  * middle := (left+right) div 2
  320.  * if middle=left then success := (s$ = a[left]) or (s$ = a[right]) else
  321.  *   if s$ < a[middle] then right := middle;  repeat from top  else
  322.  *     if s$ > a[middle] then left := middle;  repeat from top  else  success := true;
  323.  *
  324.  * The success flag may be left undefined before entering the search routine
  325.  *)
  326. LABEL loop;
  327. VAR
  328.   flag
  329. : BOOLEAN;
  330.  
  331.   b, m, t
  332. : WORD;
  333.  
  334. {listkeys, nkeys}
  335. BEGIN
  336.   b := 1;  t := nkeys;
  337.  
  338. loop :
  339.   m := (b + t) DIV 2;
  340.   IF (m = b) THEN
  341.      flag := ( (s = listkeys [b]) OR (s = listkeys [t]) )
  342.   ELSE
  343.      IF (s < listkeys [m]) THEN
  344.         BEGIN
  345.         t := m;
  346.         GOTO loop;
  347.         END
  348.      ELSE
  349.         IF (s > listkeys [m]) THEN
  350.            BEGIN
  351.            b := m;
  352.            GOTO loop;
  353.            END
  354.         ELSE
  355.            flag := TRUE;
  356.  
  357.   binsearch := flag;
  358. END;  (* binsearch *)
  359.  
  360. PROCEDURE writeblock;
  361. {ib, outfile, b nwrit, oname}
  362. BEGIN
  363.   BLOCKWRITE (outfile, b^, ib, nwrit);
  364.  
  365.   IF (nwrit <> ib) AND (oname <> '') THEN  (* Don't check output to STDOUT *)
  366.   BEGIN
  367.   WRITELN ('pb:  cannot finish outputting');
  368.   WRITELN ('ib = ', ib, ' nwritten = ', nwrit);
  369.   CLOSE (outfile);
  370.   HALT;
  371.   END;
  372.   
  373.   ib := 0;
  374. END;  (* writeblock *)
  375.  
  376. PROCEDURE getblock;
  377. {ia, infile, a, sizebuf, nread}
  378. BEGIN
  379.   ia := 0;  BLOCKREAD (infile, a^, sizebuf, nread);
  380.   
  381.   IF (nread = 0) THEN
  382.      BEGIN
  383.      writeblock;
  384.      CLOSE (infile);
  385.      HALT;
  386.      END;
  387. END;  (* getblock *)
  388.  
  389. PROCEDURE skipspace;
  390. {a, ia, nread}
  391. BEGIN
  392.   WHILE ( (a^ [ia] = #32) OR (a^ [ia] = #13) OR (a^ [ia] = #10) ) DO
  393.         BEGIN
  394.         INC (ia);  IF (ia >= nread) THEN getblock;
  395.         END;
  396. END;  (* skipspace *)
  397.  
  398. PROCEDURE outc (c : CHAR);
  399. {b, ib, lastch, sizebuf}
  400. BEGIN
  401.   CASE c OF
  402.     '[', '(', '<', '+', '/', '*', '-', ':' :
  403.       IF (lastch <> #32) AND (lastch <> #13) AND (lastch <> #10) THEN
  404.          BEGIN
  405.          b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  406.          END;
  407.  
  408.     '=' :
  409.       IF (lastch <> #32) AND (lastch <> #13) AND (lastch <> #10) AND
  410.          (lastch <> ':') AND (lastch <> '<') AND (lastch <> '>') THEN
  411.          BEGIN
  412.          b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  413.          END;
  414.  
  415.     '>' :
  416.       IF (lastch <> #32) AND (lastch <> #13) AND (lastch <> #10) AND
  417.          (lastch <> '<') THEN
  418.          BEGIN
  419.          b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  420.          END;
  421.  
  422.     ')' :
  423.       IF (lastch = ')') THEN
  424.          BEGIN
  425.          b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  426.          END;
  427.  
  428.     ELSE  (* case c *)
  429.  
  430.       IF (c <> #32) AND (c <> #13) AND (c <> #10) THEN
  431.       CASE lastch OF
  432.         '<' :
  433.           IF (c <> '>') AND (c <> '=') THEN
  434.              BEGIN
  435.              b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  436.              END;
  437.  
  438.         '>' :
  439.           IF (c <> '=') THEN
  440.              BEGIN
  441.              b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  442.              END;
  443.  
  444.         ':' :
  445.           IF (c <> '=') THEN
  446.              BEGIN
  447.              b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  448.              END;
  449.  
  450.         ')' :
  451.           IF (c <> ';') AND (c <> ',') THEN
  452.              BEGIN
  453.              b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  454.              END;
  455.  
  456.         '=', '+', '/', '*', '-', ',' :
  457.           BEGIN
  458.           b^ [ib] := #32;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  459.           END;
  460.       END;  (* case lastch *)
  461.   END;  (* case c *)
  462.  
  463.   b^ [ib] := c;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  464.   lastch := c;
  465.  
  466. END;  (* outc *)
  467.  
  468. PROCEDURE outp (c : CHAR);
  469. {b, ib, lastch, sizebuf}
  470. BEGIN
  471.   b^ [ib] := c;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  472. END;  (* outp *)
  473.  
  474. PROCEDURE outl (s : STRING);
  475. VAR
  476.   ch
  477. : CHAR;
  478.  
  479.   i, len
  480. : INTEGER;
  481. {b, ib, sizebuf}
  482. BEGIN
  483.   len := LENGTH (s);
  484.   IF (len <> 0) THEN
  485.      BEGIN
  486.      ch := s [1];
  487.      IF (ch >= 'A') AND (ch <= 'Z') THEN
  488.         ch := CHR (ORD (ch) + 32);
  489.      outc (ch);
  490.      END;
  491.  
  492.   FOR i := 2 TO len DO
  493.       BEGIN
  494.       ch := s [i];
  495.       IF (ch >= 'A') AND (ch <= 'Z') THEN
  496.          ch := CHR (ORD (ch) + 32);
  497.       b^ [ib] := ch;  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  498.       END;
  499.  
  500.   lastch := ch;
  501. END;  (* outl *)
  502.  
  503. PROCEDURE outs (s : STRING);
  504. VAR
  505.   i, len
  506. : INTEGER;
  507. BEGIN
  508.   len := LENGTH (s);
  509.   IF (len <> 0) THEN
  510.      outc (s [1]);
  511.  
  512.   FOR i := 2 TO len DO
  513.       BEGIN
  514.       b^ [ib] := s [i];  INC (ib);  IF (ib = sizebuf) THEN writeblock;
  515.       END;
  516.  
  517.   lastch := s [len];
  518. END;  (* outs *)
  519.  
  520. PROCEDURE SplitPFE (pf : STRING; VAR p : STRING; VAR f : STRING; VAR e : STRING);
  521. VAR i : INTEGER;
  522. BEGIN
  523.   p := ''; f := ''; e := '';
  524.   i := LENGTH (pf);
  525.  
  526.   WHILE ( (POS (COPY (pf, i, 1), ':/\') = 0) AND (i > 0) ) DO DEC (i);
  527.  
  528.   p := COPY (pf, 1, i);
  529.   f := COPY (pf, i + 1, 255);
  530.  
  531.   i := POS ('.', f);
  532.  
  533.   IF (i > 0) THEN
  534.      BEGIN
  535.      e := COPY (f, i + 1, 3);
  536.      f := COPY (f, 1, i);
  537.      END;
  538. END;
  539.  
  540.  
  541. {---- MAIN PROGRAM ----}
  542. BEGIN
  543.  
  544.   IF (PARAMCOUNT = 0) THEN
  545.      BEGIN
  546.      WRITELN (#10'ED''S PASCAL BEAUTIFIER v1.5, Copyright 1991 by Edward Lee, -Ed L');
  547.      WRITELN ('edlee@chinet.chi.il.us');
  548.      WRITELN (#10'DESCRIPTION:');
  549.      WRITELN ('  This program capitalizes keywords and adds spaces around certain tokens.');
  550.      WRITELN ('  Optionally, this program filters comments and uncapitalizes user-defined');
  551.      WRITELN ('  LABEL, CONSTant, TYPE, VARiable, FUNCTION, and PROCEDURE identifiers.');
  552.      WRITELN ('  In addition, this program can perform identifier substitutions by ignoring');
  553.      WRITELN ('  identifiers that are in comments or literal strings, unlike most editors.');
  554.      WRITELN (#10'INVOCATION:'#13#10'  epb [-biLop] [infile] [outfile] [-s Identifier Replacement]');
  555.      WRITELN (#10'OPTIONS (case insensitive):');
  556.      WRITELN (' -b  Shut off the output of Bracket comments:  { ... }');
  557.      WRITELN (' -p  Shut off the output of Parentheses comments:  (* ... *)');
  558.      WRITELN (' -i  Use the STDIN  stream for Input  instead of INFILE');
  559.      WRITELN (' -o  Use the STDOUT stream for Output instead of OUTFILE');
  560.      WRITELN (' -L  Cast all alphabetic characters that are non-keywords, non-comments,');
  561.      WRITELN ('     and non-string literals into Lower case');
  562.      WRITELN (' -s  Substitue all occurances of Identifier with a Replacement string');
  563.      WRITELN ('     through a case-insensitive search.');
  564.      HALT;
  565.      END;
  566.  
  567.   showparencom := TRUE;
  568.   showbrackcom := TRUE;
  569.   istream := FALSE;
  570.   ostream := FALSE;
  571.   lowercase := FALSE;
  572.  
  573.   Oident := '';
  574.   RLident := '';
  575.   RUident := '';
  576.   
  577.   i := 0;
  578.   WHILE (i < PARAMCOUNT) DO    (* Process options *)
  579.         BEGIN
  580.         INC (i);
  581.         s := PARAMSTR (i);
  582.         IF (s [1] = '-') THEN
  583.            BEGIN
  584.            IF (POS ('b', s) > 0) OR (POS ('B', s) > 0) THEN
  585.               showbrackcom := FALSE;
  586.            IF (POS ('p', s) > 0) OR (POS ('P', s) > 0) THEN
  587.               showparencom := FALSE;
  588.            IF (POS ('i', s) > 0) OR (POS ('I', s) > 0) THEN
  589.               istream := TRUE;
  590.            IF (POS ('o', s) > 0) OR (POS ('O', s) > 0) THEN
  591.               ostream := TRUE;
  592.            IF (POS ('l', s) > 0) OR (POS ('L', s) > 0) THEN
  593.               lowercase := TRUE;
  594.            IF (POS ('s', s) > 0) OR (POS ('S', s) > 0) THEN
  595.               BEGIN
  596.               INC (i);
  597.               Oident := PARAMSTR (i);
  598.               INC (i);
  599.               RLident := PARAMSTR (i);
  600.               IF (i > PARAMCOUNT) THEN
  601.                  BEGIN
  602.                  WRITELN ('epb:  Error.  The -s option has been used without enough parameters.');
  603.                  HALT;
  604.                  END;
  605.               END;  (* if (pos ('s' ... *)
  606.            END;  (* if (s [1] ... *)
  607.         END;  (* while *)
  608.  
  609. (* Normalize Original and Replacement strings via upper case function *)
  610.   FOR i := 1 TO LENGTH (Oident) DO
  611.       Oident [i] := UPCASE (Oident [i]);
  612.  
  613.   FOR i := 1 TO LENGTH (RLident) DO
  614.       RUident := RUident + UPCASE (RLident [i]);
  615.  
  616.   iname := '';
  617.   oname := '';
  618.  
  619.   IF NOT (istream AND ostream) THEN
  620.      BEGIN
  621.      i := 0;
  622.      WHILE (i < PARAMCOUNT) DO    (* Get filename(s) *)
  623.            BEGIN
  624.            INC (i);
  625.            s := PARAMSTR (i);
  626.  
  627.            IF (s [1] <> '-') THEN   (* Skip option flags *)
  628.               BEGIN
  629.               IF (istream) THEN     (* Input is from STDIN *)
  630.                  BEGIN
  631.                  oname := s;
  632.                  GOTO out;
  633.                  END
  634.               ELSE
  635.                  IF (ostream) THEN     (* Output is to STDOUT *)
  636.                     BEGIN
  637.                     iname := s;
  638.                     GOTO out;
  639.                     END
  640.                  ELSE
  641.                     IF (iname = '') THEN  (* Input is from infile *)
  642.                        iname := s
  643.                     ELSE
  644.                        BEGIN
  645.                        oname := s;        (* Output is to outfile *)
  646.                        GOTO out;
  647.                        END;
  648.               END  (* if (s [1] ... *)
  649.  
  650.            ELSE
  651.  
  652.               IF (POS ('s', s) > 0) OR (POS ('S', s) > 0) THEN
  653.                  i := i + 2;
  654.  
  655.            END;  (* while *)
  656.      END;  (* if not *)
  657.  
  658. out :
  659.   splitPFE (iname, path, filename, ext);
  660.  
  661.   IF (COPY (filename, LENGTH (filename), 1) <> '.') THEN
  662.      BEGIN
  663.      filename := filename + '.';
  664.      ext := 'PAS';
  665.      iname := path + filename + ext;
  666.      END;
  667.  
  668.   s := path + filename + 'BAK';
  669.  
  670.   IF (iname <> '') THEN
  671.      IF (iname = oname) OR
  672.         ( (oname = '') AND NOT ostream) THEN
  673.         BEGIN
  674.  
  675.         ASSIGN (infile, s);
  676.         {$I-} RESET (infile, 1); {$I+}
  677.         IF (IORESULT = 0) THEN
  678.            BEGIN
  679.            CLOSE (infile);
  680.            ERASE (infile);
  681.            END;
  682.  
  683.         ASSIGN (infile, iname);
  684.         {$I-} RESET (infile, 1); {$I+}
  685.         IF (IORESULT = 0) THEN
  686.            BEGIN
  687.            CLOSE (infile);
  688.            RENAME (infile, s);
  689.            END
  690.         ELSE
  691.            BEGIN
  692.            WRITELN ('epb:  cannot rename original file, ', iname, ', to ', s, '.');
  693.            HALT;
  694.            END;
  695.  
  696.         oname := iname;
  697.         iname := s;
  698.         END;
  699.  
  700.   ASSIGN (infile, iname);
  701.   {$I-} RESET (infile, 1); {$I+}
  702.   IF (IORESULT <> 0) THEN
  703.      BEGIN
  704.      WRITELN ('epb:  cannot open input file, ', iname);
  705.      HALT;
  706.      END;
  707.  
  708.   splitPFE (oname, path, filename, ext);
  709.  
  710.   IF (COPY (filename, LENGTH (filename), 1) <> '.') THEN
  711.      BEGIN
  712.      filename := filename + '.';
  713.      ext := 'PAS';
  714.      oname := path + filename + ext;
  715.      END;
  716.  
  717.   ASSIGN (outfile, oname);  REWRITE (outfile, 1);
  718.  
  719.   NEW (a);
  720.   NEW (b);
  721.   getblock;
  722.   
  723.   ib := 0;
  724.   lastch := #0;
  725.   lstr := '';
  726.   ustr := '';
  727.  
  728. start :
  729.   ch := a^ [ia];
  730.   
  731.   CASE ch OF
  732.  
  733.     #39 :   (* Do not process the contents of literal strings *)
  734.       BEGIN
  735.       outc (a^ [ia]);
  736.       INC (ia);  IF (ia >= nread) THEN getblock;
  737.       outp (a^ [ia]);
  738.       WHILE (a^ [ia] <> #39) DO
  739.             BEGIN
  740.             INC (ia);  IF (ia >= nread) THEN getblock;
  741.             outp (a^ [ia]);
  742.             END;  (* a^[ia] = #39 *)
  743.       INC (ia);  IF (ia >= nread) THEN getblock;
  744.       GOTO start;
  745.       END;
  746.  
  747.     '{' :   (* Do not process the contents of { ... } comments *)
  748.       BEGIN
  749.       IF (showbrackcom) THEN outc (a^ [ia]);
  750.       INC (ia);  IF (ia >= nread) THEN getblock;
  751.       IF (showbrackcom) THEN outp (a^ [ia]);
  752.       WHILE (a^ [ia] <> '}') DO
  753.             BEGIN
  754.             INC (ia);  IF (ia >= nread) THEN getblock;
  755.             IF (showbrackcom) THEN outp (a^ [ia]);
  756.             END;  (* a^[ia] = '}' *)
  757.       INC (ia);  IF (ia >= nread) THEN getblock;
  758.       GOTO start;
  759.       END;
  760.  
  761.     '(' :   { Do not process the contents of (* ... *) comments }
  762.       BEGIN
  763.       INC (ia);  IF (ia >= nread) THEN getblock;
  764.       IF (a^ [ia] <> '*') THEN
  765.          BEGIN
  766.          outc (ch);
  767.          GOTO start;
  768.          END
  769.       ELSE   (* A comment has begun *)
  770.          BEGIN
  771.          IF (showparencom) THEN
  772.             BEGIN
  773.             outp (ch);  outp (a^ [ia]);
  774.             END;
  775.  
  776.          INC (ia);  IF (ia >= nread) THEN getblock;
  777.          IF (showparencom) THEN outp (a^ [ia]);
  778.  
  779. findasterisk :
  780.          WHILE (a^ [ia] <> '*') DO
  781.                BEGIN
  782.                INC (ia);  IF (ia >= nread) THEN getblock;
  783.                IF (showparencom) THEN outp (a^ [ia]);
  784.                END;  (* a^[ia] = '*' *)
  785.  
  786.          INC (ia);  IF (ia >= nread) THEN getblock;
  787.          IF (showparencom) THEN outp (a^ [ia]);
  788.          
  789.          IF (a^ [ia] <> ')') THEN GOTO findasterisk;
  790.          INC (ia);  IF (ia >= nread) THEN getblock;
  791.          GOTO start;
  792.          END;
  793.       END;
  794.  
  795.     'A'..'Z', 'a'..'z', '_' :
  796.       BEGIN
  797.         REPEAT
  798.         ustr := ustr + UPCASE (ch);
  799.         lstr := lstr + ch;
  800.         INC (ia);  IF (ia >= nread) THEN getblock;
  801.         ch := a^ [ia];
  802.         UNTIL ( (ch < 'A') OR (ch > 'Z') ) AND
  803.               ( (ch < 'a') OR (ch > 'z') ) AND
  804.               ( (ch < '0') OR (ch > '9') ) AND
  805.               (ch <> '_');  {Turbo Pascal Sets are too slow}
  806.  
  807.       IF (ustr = Oident) THEN
  808.          BEGIN
  809.          ustr := RUident;
  810.          lstr := RLident;
  811.          END;
  812.  
  813.       IF (binsearch (ustr) ) THEN
  814.          outs (ustr)
  815.       ELSE
  816.          IF (lowercase) THEN
  817.             outl (lstr)
  818.          ELSE
  819.             outs (lstr);
  820.  
  821.       lstr := '';  ustr := '';
  822.       GOTO start;
  823.       END;
  824.  
  825.   ELSE
  826.  
  827.       BEGIN
  828.       outc (ch);
  829.       INC (ia);  IF (ia >= nread) THEN getblock;
  830.       GOTO start;
  831.       END;
  832.  
  833.   END;  (* CASE ch *)
  834.  
  835. (*Inline Procedures:
  836.  *  skipquote (a, ia);
  837.  *  skipbrack (a, ia);
  838.  *  skipparens(a, ia);
  839.  *  getident  (a, ia);
  840.  *)
  841. END.
  842.